#lang racket


(require "../base/main.rkt")

(provide
 ; primitives
 arc
 set-arc!
 
 elliptical-arc
 set-elliptical-arc!
 
 circle
 set-circle!
 
 donut
 set-donut!
 
 ellipse
 set-ellipse!
 
 helix-2d
 set-helix-2d!
 
 line
 set-line!
 
 ngon
 set-ngon!
 
 nurbs-curve
 set-nurbs-curve!
 
 nurbs-surface
 set-nurbs-surface!
 
 rectangle
 set-rectangle!
 
 spline
 set-spline!
 
 star
 set-star!
 
 ;text
 ;set-text!
 
 box
 set-box!
 
 cone
 set-cone!
 
 cone-frustrum
 set-cone-frustrum!
 
 cylinder
 set-cylinder!
 
 pipe
 set-pipe!
 
 sphere
 set-sphere!
 
 ; operations
 extrude
 set-extrude!
 
 intersect
 set-intersect!
 
 join
 set-join!
 
 loft
 set-loft!
 
 move
 set-move!
 
 offset
 set-offset!
 
 rotate
 set-rotate!
 
 scale
 set-scale!
 
 subtract
 set-subtract!
 
 sweep
 set-sweep!
 
 union
 set-union!
 
 ; lang
 on-left
 set-on-left!
 
 on-right
 set-on-right!
 
 on-x
 set-on-x!
 
 on-front
 set-on-front!
 
 on-back
 set-on-back!
 
 on-y
 set-on-y!
 
 on-top
 set-on-top!
 
 on-bottom
 set-on-bottom!
 
 on-z
 set-on-z!
 
 evaluate
 set-evaluate!
 
 evaluate-toplevel
 set-evaluate-toplevel!
 
 parametrize
 set-parametrize!
 
 ; autocad
 arc-ppp
 set-arc-ppp!)


; utils

(define (raise-abstract sym)
  (raise-user-error sym "Abstract function"))


; primitives

(define (arc angle radius)
  (raise-abstract 'arc))

(define (set-arc! f)
  (set! arc f))


(define (elliptical-arc angle x-radius y-radius)
  (raise-abstract 'elliptical-arc))

(define (set-elliptical-arc! f)
  (set! elliptical-arc f))


(define (circle radius)
  (raise-abstract 'circle))

(define (set-circle! f)
  (set! circle f))


(define (donut inner-radius outer-radius)
  (raise-abstract 'donut))

(define (set-donut! f)
  (set! donut f))


(define (ellipse x-radius y-radius)
  (raise-abstract 'ellipse))

(define (set-ellipse! f)
  (set! ellipse f))


(define (helix-2d base-radius top-radius turns turn-height direction)
  (raise-abstract 'helix-2d))

(define (set-helix-2d! f)
  (set! helix-2d f))


; line

(define (line-impl points)
  (raise-abstract 'line-impl))

(define line
  (case-lambda
    ((point1 point2 . points)
     (line-impl (cons point1 (cons point2 points))))
    ((points)
     (line-impl points))))

(define (set-line! f)
  (set! line-impl f))

; /line


(define (ngon width sides)
  (raise-abstract 'ngon))

(define (set-ngon! f)
  (set! ngon f))


(define (nurbs-curve controls knots)
  (raise-abstract 'nurbs-curve))

(define (set-nurbs-curve! f)
  (set! nurbs-curve f))


(define (nurbs-surface controls u-knots v-knots)
  (raise-abstract 'nurbs-surface))

(define (set-nurbs-surface! f)
  (set! nurbs-surface f))


(define (rectangle width length)
  (raise-abstract 'rectangle))

(define (set-rectangle! f)
  (set! rectangle f))


(define (spline points)
  (raise-abstract 'spline))

(define (set-spline! f)
  (set! spline f))


(define (star width sides stride)
  (raise-abstract 'star))

(define (set-star! f)
  (set! star f))


;(define (text text)
;  (raise-abstract 'text)


(define (box width length height)
  (raise-abstract 'box))

(define (set-box! f)
  (set! box f))


(define (cone radius height)
  (raise-abstract 'cone))

(define (set-cone! f)
  (set! cone f))


(define (cone-frustrum base-radius top-radius height)
  (raise-abstract 'cone-frustrum))

(define (set-cone-frustrum! f)
  (set! cone-frustrum f))


(define (cylinder radius height)
  (raise-abstract 'cylinder))

(define (set-cylinder! f)
  (set! cylinder f))


;(define (elliptical-cone x-radius y-radius height))
;(define (gengon width sides fillet-width height))
;(define (helix-3d base-radius top-radius section-radius turns turn-height direction))
;(define (mesh vertices faces))
;(define (paraboloid radius height))


(define (pipe inner-radius outer-radius height)
  (raise-abstract 'pipe))

(define (set-pipe! f)
  (set! pipe f))


;(define (platonic-solids width sides))
;(define (pyramid width sides height))


(define (sphere radius)
  (raise-abstract 'sphere))

(define (set-sphere! f)
  (set! sphere f))


; operations

;(define (spindle radius height))
;(define (superellipsoid width length height))
;(define (torus base-radius section-radius))
;(define (truncated-icosahedron width))
;(define (wedge width height))


(define (extrude length surface)
  (raise-abstract 'extrude))

(define (set-extrude! f)
  (set! extrude f))


;(define (guide-loft guide shapes))


; intersect

(define (intersect-impl shape1 shape2)
  (raise-abstract 'intersect-impl))

(define (intersect-list l)
  (reduce (λ (s ss) (intersect-impl ss s)) l))

(define intersect
  (case-lambda
    ((shape1 shape2 . shapes)
     (intersect-list (cons shape1 (cons shape2 shapes))))
    ((shapes)
     (intersect-list shapes))))

(define (set-intersect! f)
  (set! intersect-impl f))

; /intersect


;(define (lattice shape))


; join

(define (join-impl shapes)
  (raise-abstract 'join-impl))

(define join
  (case-lambda
    ((shape1 shape2 . shapes)
     (join-impl (cons shape1 (cons shape2 shapes))))
    ((shapes)
     (join-impl shapes))))

(define (set-join! shapes)
  (set! join-impl shapes))

; /join

; loft

(define (loft-impl closed shapes)
  (raise-abstract 'loft))

(define loft
  (case-lambda
    ((closed shapes)
     (loft-impl closed shapes))
    ((shapes)
     (loft #f shapes))))

(define (set-loft! f)
  (set! loft-impl f))

; /loft


;(define (mirror plane shape))


(define (move position shape)
  (raise-abstract 'move))

(define (set-move! f)
  (set! move f))


(define (offset distance shape)
  (raise-abstract 'offset))

(define (set-offset! f)
  (set! offset f))


;(define (path-loft path shapes))
;(define (revolve axis shape))


(define (rotate angle normal shape)
  (raise-abstract 'rotate))

(define (set-rotate! f)
  (set! rotate f))


(define (scale scale shape)
  (raise-abstract 'scale))

(define (set-scale! f)
  (set! scale f))


;(define (slice plane shape))


; subtract

(define (subtract-impl shape1 shape2)
  (raise-abstract 'subtract-impl))

(define (subtract-list l)
  (reduce (λ (s ss) (subtract-impl ss s)) l))

(define subtract
  (case-lambda
    ((shape1 shape2 . shapes)
     (subtract-list (cons shape1 (cons shape2 shapes))))
    ((shapes)
     (apply subtract shapes))))

(define (set-subtract! f)
  (set! subtract-impl f))

; /subtract


; sweep

(define (sweep shape path)
  (raise-abstract 'sweep))

(define (set-sweep! f)
  (set! sweep f))

; /sweep


;(define (thicken length shape))


; union

(define (union-impl shape1 shape2)
  (raise-abstract 'union-impl))

(define (union-list l)
  (reduce (λ (s ss) (union-impl ss s)) l))

(define union
  (case-lambda
    ((shape1 shape2 . shapes)
     (union-list (cons shape1 (cons shape2 shapes))))
    ((shapes)
     (union-list shapes))))

(define (set-union! f)
  (set! union-impl f))

; /union


; lang

(define (make-on-proc impl)
  (letrec ((proc
            (case-lambda
              ((node1 node2 . nodes)
               (reducer impl (cons node1 (cons node2 nodes))))
              ((nodes)
               (apply proc nodes)))))
    proc))


; on-left

(define (on-left-impl node1 node2)
  (raise-abstract 'on-left-impl))

(define on-left (make-on-proc (λcall on-left-impl)))

(define (set-on-left! f)
  (set! on-left-impl f))

; /on-left


; on-right

(define (on-right-impl node1 node2)
  (raise-abstract 'on-right-impl))

(define on-right (make-on-proc (λcall on-right-impl)))

(define (set-on-right! f)
  (set! on-right-impl f))

; /on-right


; on-x

(define (on-x-impl node1 node2)
  (raise-abstract 'on-x))

(define on-x (make-on-proc (λcall on-x-impl)))

(define (set-on-x! f)
  (set! on-x-impl f))

; /on-x


; on-front

(define (on-front-impl node1 node2)
  (raise-abstract 'on-front-impl))

(define on-front (make-on-proc (λcall on-front-impl)))

(define (set-on-front! f)
  (set! on-front-impl f))

; /on-front


; on-back

(define (on-back-impl node1 node2)
  (raise-abstract 'on-back-impl))

(define on-back (make-on-proc (λcall on-back-impl)))

(define (set-on-back! f)
  (set! on-back-impl f))

; /on-back


; on-y

(define (on-y-impl node1 node2)
  (raise-abstract 'on-y-impl))

(define on-y (make-on-proc (λcall on-y-impl)))

(define (set-on-y! f)
  (set! on-y-impl f))

; /on-y


; on-top

(define (on-top-impl node1 node2)
  (raise-abstract 'on-top-impl))

(define on-top (make-on-proc (λcall on-top-impl)))

(define (set-on-top! f)
  (set! on-top-impl f))

; /on-top


; on-bottom

(define (on-bottom-impl node1 node2)
  (raise-abstract 'on-bottom-impl))

(define on-bottom (make-on-proc (λcall on-bottom-impl)))

(define (set-on-bottom! f)
  (set! on-bottom-impl f))

; /on-bottom


; on-z

(define (on-z-impl node1 node2)
  (raise-abstract 'on-z-impl))

(define on-z (make-on-proc (λcall on-z-impl)))

(define (set-on-z! f)
  (set! on-z-impl f))

; /on-z


(define (parametrize form)
  (raise-abstract 'parametrize))

(define (set-parametrize! f)
  (set! parametrize f))


(define (evaluate form)
  (raise-abstract 'evaluate))

(define (set-evaluate! f)
  (set! evaluate f))


(define (evaluate-toplevel form)
  (raise-abstract 'evaluate-toplevel))

(define (set-evaluate-toplevel! f)
  (set! evaluate-toplevel f))


; autocad

(define (arc-ppp p1 p2 p3)
  (raise-abstract 'arc-ppp))

(define (set-arc-ppp! f)
  (set! arc-ppp f))